home *** CD-ROM | disk | FTP | other *** search
/ Mac100% 1998 November / MAC100-1998-11.ISO.7z / MAC100-1998-11.ISO / ｵﾝﾗｲﾝｿﾌﾄ定点観測 / ﾕｰﾃｨﾘﾃｨ / Mops 3.2.sea / Mops 3.2 / Mops source / PPC source / pBytestring < prev    next >
Text File  |  1998-02-04  |  2KB  |  116 lines
  1. (*
  2. The class Bytestring adds further methods to the class String+, aimed
  3. mainly at managing strings of bytes which are arbitrary data, not
  4. just ascii characters, and may contain non-aligned 16- or 32-bit quantities.
  5. (Some of the fields in PEF files are good examples.)
  6.  
  7. These methods allow various numbers of bytes to be fetched from
  8. or stored to the current position of the string, with the current
  9. position being updated.
  10. *)
  11.  
  12. marker m_pBytestring
  13.  
  14. :class  BYTESTRING  super{ string }
  15.  
  16. :m 1stW:        ¥ ( -- n )
  17.     ^1st: self  w@  ;m
  18.  
  19. :m 1stL:        ¥ ( -- n )
  20.     ^1st: self  @  ;m
  21.  
  22. :m >1st:        ¥ ( c -- )
  23.     ^1st: self  c!  ;m
  24.  
  25. :m >1stW:        ¥ ( n -- )
  26.     ^1st: self  w!  ;m
  27.  
  28. :m >1stL:
  29.     ^1st: self  !  ;m
  30.  
  31.  
  32. :m nxtC:        ¥ ( -- c )
  33.     1st: self  1 skip: self  ;m
  34.  
  35. :m nxtW:        ¥ ( -- n )
  36.     1stW: self  2 skip: self  ;m
  37.  
  38. :m NXTL:        ¥ ( -- n )
  39.     1stL: self  4 skip: self  ;m
  40.  
  41. :m NXTN:  { n -- n' }
  42.     get: self  n >=
  43.     IF    0 swap  n bounds DO  8 << i c@ or  LOOP
  44.         n skip: self
  45.     ELSE    drop 0
  46.     THEN  ;m
  47.  
  48.  
  49. :m >NXTC:           ¥ ( c -- )
  50.     >1st: self  1 skip: self  ;m
  51.  
  52. :m >NXTW:           ¥ ( n -- )
  53.     >1stW: self  2 skip: self  ;m
  54.  
  55. :m >NXTL:            ¥ ( n -- )
  56.     >1stL: self  4 skip: self  ;m
  57.  
  58. :m >NXT$:       ¥ ( addr len -- )
  59.     ovwr: self  ;m
  60.  
  61. :m >NXTN:  { val n  -- }
  62.     val pad !
  63.     4 n - pad +  n  >nxt$: self  ;m
  64.     
  65.  
  66. :m +C:        ¥ ( c -- )
  67.     +: self   ;m
  68.  
  69. :m +W:        ¥ ( n -- )
  70.     pad w!  pad 2  add: self  ;m
  71.  
  72. :m +L:        ¥ ( n -- )
  73.     pad !   pad 4  add: self  ;m
  74.  
  75. :m +N:  { n cnt -- }
  76.     n  32  cnt 2* 4* -  <<  pad !
  77.     pad cnt  add: self  ;m
  78.  
  79. ;class
  80.  
  81. marker m__cg1
  82. endload
  83.  
  84. ¥ =========== the current test block ============
  85.  
  86. : selectTest
  87.     SELECT[    1    ]=>
  88.           [    2    ]=>
  89.           [    3    ]=>    23
  90.           [ 6    ]=> 200 200 dump
  91.           [ 9    ]=> 99 88 77
  92.     DEFAULT=> 1234
  93.     ]SELECT
  94. ;
  95.  
  96.  
  97. :f TEST { ¥ x -- }
  98. dbgr
  99.     cr cr ." hi there one and all!" cr  1 2 3
  100.     begin
  101.         query cr
  102.         begin
  103.             rest nip 0>
  104.         while
  105.             defined?
  106.             if        execute
  107.             else
  108.                     number  selectTest
  109.             then
  110.         repeat
  111.         .s cr
  112.     again
  113. ;f
  114.  
  115. :f quit  test  ;f        ¥ temp so we can catch errors!
  116.